home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / alph100p.zip / CRTDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-02  |  1KB  |  54 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  2. {$M 1024,0,0}
  3. program CrtDemo;
  4.  
  5. uses CRT;
  6.  
  7. Type
  8.  Proc = Procedure;
  9.  
  10. Procedure Plain; Far;
  11. begin
  12. end;
  13.  
  14. Procedure SPage(s: string; P: Proc);
  15. var L,n,m:byte;
  16. begin
  17.   Textbackground(black);
  18.   textcolor(yellow);
  19.   clrscr;
  20.   gotoxy(33,1);write('CRT COLOR DEMO');
  21.   gotoxy(35,3);write(S);
  22.   gotoxy(15,4);write('Background');
  23.   gotoxy(55,4);write('Foreground');
  24.   for n:=15 downto 0 do
  25.     begin
  26.       TextBackground(n);
  27.       TextColor(n);
  28.       P;
  29.       gotoxy(1,n+5);
  30.       for m:=1 to 40 do write(#32);
  31.       for m:=1 to 40 do write(#219);
  32.       inc(l)
  33.     end;
  34.     Sound(333);delay(200);nosound;
  35.     delay(5000);
  36. end;
  37.  
  38. begin
  39.   DirectVideo:=FALSE;
  40.  
  41.   spage('Plain CRT',Plain);
  42.   spage('HighVideo',HighVideo);
  43.   spage('LowVideo', LowVideo);
  44.  
  45.   Assign(OutPut,'');Rewrite(OutPut);   { NOTICE HOW REDIRECTION TURNS OFF COLOR }
  46.   spage('Redirected Plain CRT',Plain);
  47.   spage('Redirected HighVideo',HighVideo);
  48.   spage('Redirected LowVideo', LowVideo);
  49.  
  50.   normvideo;
  51.   clrscr;
  52.   halt(0);
  53. end.
  54.